home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / phigs / ptk.lha / ptk / fortran / source / library / misc.f < prev    next >
Encoding:
Text File  |  1992-06-18  |  2.1 KB  |  76 lines
  1.  
  2.        SUBROUTINE ptkf_inqcurelemtype(error, eltype)
  3. C /*
  4. C ** \parambegin
  5. C ** \param{INTEGER}{error}{error indicator}{OUT}
  6. C ** \param{INTEGER}{eltype}{element type}{OUT}
  7. C ** \paramend 
  8. C ** \blurb{This function may be used to obtain the current element type
  9. C ** and works for both SunPHIGS and DEC PHIGS.}
  10. C */
  11.        INTEGER error, eltype
  12.        external ptk_inqcurelemtype !$PRAGMA C(ptk_inqcurelemtype)
  13.  
  14.        call ptk_inqcurelemtype(error, eltype)
  15.  
  16.        RETURN
  17.        END
  18.  
  19.        SUBROUTINE ptkf_inqelemtype(stid, elemid, error, eltype)
  20. C /*
  21. C ** \parambegin
  22. C ** \param{INTEGER}{stid}{structure identifier}{IN}
  23. C ** \param{INTEGER}{elemid}{element number}{IN}
  24. C ** \param{INTEGER}{error}{error indicator}{OUT}
  25. C ** \param{INTEGER}{eltype}{element type}{OUT}
  26. C ** \paramend 
  27. C ** \blurb{This function may be used to obtain the element type of
  28. C ** element {\tt elemid} in structure {\tt stid}
  29. C ** and works for both SunPHIGS and DEC PHIGS.}
  30. C */
  31.        INTEGER stid, elemid, error, eltype
  32.        external ptk_inqelemtype !$PRAGMA C(ptk_inqelemtype)
  33.  
  34.        call ptk_inqelemtype(%val(stid), %val(elemid), error, eltype)
  35.  
  36.        RETURN
  37.        END
  38.  
  39.        INTEGER FUNCTION ptkf_fopen(filename, type)
  40. C /*
  41. C ** \parambegin
  42. C ** \param{CHARACTER*(*)}{filename}{name of file to open}{IN}
  43. C ** \param{CHARACTER*(*)}{type}{type string for reading or writing}{IN}
  44. C ** \paramend 
  45. C ** \blurb{This function may be used to open a file and
  46. C ** obtain the file pointer to the open file.
  47. C ** The pointer is returned as the result of the function.}
  48. C */
  49.        CHARACTER*(*) filename, type
  50.        INTEGER*4 ptkc_fopen
  51.        external ptkc_fopen !$PRAGMA C(ptkc_fopen)
  52.  
  53.        ptkf_fopen = ptkc_fopen(filename, type)
  54.  
  55.        RETURN
  56.        END
  57.  
  58.        INTEGER FUNCTION ptkf_fclose(fileptr)
  59. C /*
  60. C ** \parambegin
  61. C ** \param{INTEGER}{fileptr}{file pointer}{IN}
  62. C ** \paramend 
  63. C ** \blurb{This function may be used to close a file using
  64. C ** the file pointer obtained from {\tt ptkf\_fopen}.}
  65. C */
  66.        INTEGER fileptr
  67.        INTEGER ptkc_fclose
  68.        external ptkc_fclose !$PRAGMA C(ptkc_fclose)
  69.  
  70.        ptkf_fclose = ptkc_fclose(%val(fileptr))
  71.  
  72.        RETURN
  73.        END
  74.  
  75. C end of misc.f
  76.